home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 84 / applic / lpatch.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-19  |  9.3 KB  |  295 lines
  1. PROGRAM lpatch ;
  2.         { patch the labels program to work with any printer }
  3.  
  4.   CONST
  5.     {$I GEMCONST.PAS}
  6.         pgmname = 'LABELS.PRG';
  7.  
  8.         numcodes = 12;
  9.         codelen = 8;
  10.  
  11.         OFF = FALSE;
  12.         ON  = TRUE;
  13.  
  14.         START_POS = $0D44;
  15.         MAGIC_POS = $0D3E;
  16.   TYPE
  17.     {$I gemtype.pas}
  18.     codearray = array[1..numcodes] of str255;
  19.     pgmfile = packed file of byte;
  20.  
  21.   VAR
  22.         infile : pgmfile;
  23.         msg,inpath : str255;
  24.         ok_button : integer;
  25.         i,j,k,start,size : integer;
  26.         found : boolean;
  27.         code,entry : codearray;
  28.         MAGIC : string[5];
  29.  
  30.    {$I gemsubs}
  31.  
  32. { *************************************************************************** }
  33.  
  34. procedure show_edit_funcs;
  35.         { shows form edit functions available to user }
  36.  
  37.    var  help_box : dialog_ptr; { the form itself }
  38.         i,
  39.         ok_button,              { the exit button }
  40.         pushed : integer;       { button the user pushed }
  41.  
  42.         item : array[1..7] of integer;         { the text lines }
  43.         line : array[1..7] of string[48];
  44.  
  45. begin
  46.  
  47. { initialize the lines }
  48.         line[1] := '       EDIT FUNCTIONS';
  49.         line[2] := '';
  50.         line[3] := 'Esc       - Erases entire line';
  51.         line[4] := 'arrows    - Move up/down lines';
  52.         line[5] := 'arrows    - Move left/right';
  53.         line[6] := 'Delete    - Erase character right';
  54.         line[7] := 'Backspace - Erase character left';
  55.  
  56. { create the object }
  57.         help_box := New_Dialog(9,0,0,36,12);
  58.  
  59. { add the text lines }
  60.         for i := 1 to 7 do begin
  61.            item[i] := Add_DItem(help_box,G_String,None,2,i,34,1,0,0);
  62.            Set_Dtext(help_box,item[i],line[i],System_font,TE_Left);
  63.         end;
  64.  
  65. { add an ok button }
  66.         ok_button := Add_Ditem(help_box,G_Button,
  67.                 Selectable | Exit_Btn | Default,14,9,8,2,0,0);
  68.         set_Dtext(help_box,ok_button,'OK',System_font,TE_Center);
  69.  
  70. { reserve room to center the dialog }
  71.         Center_dialog(help_box);
  72.  
  73. { display the box }
  74.         pushed := Do_Dialog(help_box,0);
  75.  
  76. { erase it }
  77.         End_dialog(help_box);
  78.  
  79. { release the space }
  80. {        Delete_Dialog(help_box);
  81.  }
  82. end;
  83.  
  84.  
  85. { *************************************************************************** }
  86.  
  87. procedure get_codes;
  88.  
  89. const
  90.     PROMPT1 = 'Enter codes for your printer (DECIMAL)';
  91.     PROMPT2 = 'Use ''99,99,99'' if option not available';
  92.  
  93.     BOX_WID = 50;       { must be longer than prompt }
  94.     BOX_HGT = 21;       { must be at least numcodes + 9 }
  95.     BTN_WID = 8;        { 3 * BTN_WID <= BOX_WID - 4 }
  96.     BTN_HGT = 2;
  97.     BTN_MARGIN = 5;     { best if 4*BTN_MARGIN + 3*BTN_WID = BOX_WID }
  98.  
  99. var
  100.     the_box : dialog_ptr;       { name of the box }
  101.     prompt_item,                { name of the prompt }
  102.     ok,help,quit,               { the exit buttons }
  103.     pushed,                     { which one the user exited with }
  104.     i : integer;                { loop variable }
  105.  
  106.     line : array[1..numcodes] of integer; { name of the edit lines }
  107.     template,valid,init : array[1..numcodes] of string[BOX_WID];
  108.  
  109. begin
  110.     Init_Mouse;
  111.                                 { create the box }
  112.     the_box := New_Dialog(numcodes + 7,0,0,BOX_WID,BOX_HGT);
  113.  
  114.                                 { add the prompts }
  115.     prompt_item := Add_Ditem(the_box,g_text,None,0,1,BOX_WID,1,0,
  116.                              256*BLACK+128);
  117.     Set_Dtext(the_box,prompt_item,PROMPT1,System_font,TE_Center);
  118.     prompt_item := Add_Ditem(the_box,g_text,None,0,2,BOX_WID,1,0,
  119.                              256*BLACK+128);
  120.     Set_Dtext(the_box,prompt_item,PROMPT2,System_font,TE_Center);
  121.  
  122.                                 { set up template and validation strings }
  123.     template[1]  := 'Software Reset.............:__,__,__';
  124.     template[2]  := 'Normal print (pica-10cpi)..:__,__,__';
  125.     template[3]  := 'Double wide print..........:__,__,__';
  126.     template[4]  := 'Condensed print(compressed):__,__,__';
  127.     template[5]  := 'line spacing 1/8"..........:__,__,__';
  128.     template[6]  := 'line spacing 1/6"..........:__,__,__';
  129.     template[7]  := 'Underline mode on..........:__,__,__';
  130.     template[8]  := 'Underline mode off.........:__,__,__';
  131.     template[9]  := 'Italic character set.......:__,__,__';
  132.     template[10] := 'Cancel italics.............:__,__,__';
  133.     template[11] := 'Bold or Emphasized print...:__,__,__';
  134.     template[12] := 'Cancel Emphasized print....:__,__,__';
  135.  
  136.     init[1] := '276400';
  137.     init[2] := '276601';
  138.     init[3] := '271400';
  139.     init[4] := '271500';
  140.     init[5] := '274800';
  141.     init[6] := '275000';
  142.     init[7] := '274501';
  143.     init[8] := '274500';
  144.     init[9] := '275200';
  145.     init[10] := '275300';
  146.     init[11] := '276900';
  147.     init[12] := '277000';
  148.  
  149.  
  150.     for i := 1 to numcodes do begin
  151.         valid[i]    := '999999';
  152.     end;
  153.  
  154.                                 { add the edit lines }
  155.     for i := 1 to numcodes do begin
  156.         line[i] := Add_Ditem(the_box,G_Ftext,None,1,3+i,BOX_WID,1,0,
  157.                             256*BLACK+128);
  158.         Set_Dedit(the_box,line[i],template[i],valid[i],init[i],
  159.                    System_font,TE_Center);
  160.     end;
  161.  
  162.                                 { add the exit buttons }
  163.     ok := Add_Ditem(the_box,G_button,Selectable | Exit_Btn,
  164.                     BTN_MARGIN,numcodes+5,BTN_WID,BTN_HGT,
  165.                     0,0);
  166.     Set_Dtext(the_box,ok,'OK',System_font,TE_Center);
  167.     help := Add_Ditem(the_box,G_button,Selectable | Exit_Btn,
  168.                     (BOX_WID-BTN_WID)DIV 2,numcodes+5,BTN_WID,BTN_HGT,
  169.                     0,0);
  170.     Set_Dtext(the_box,help,'HELP',System_font,TE_Center);
  171.     quit := Add_Ditem(the_box,G_button,Selectable | Exit_Btn,
  172.                     BOX_WID-BTN_WID-BTN_MARGIN,numcodes+5,BTN_WID,BTN_HGT,
  173.                     0,0);
  174.     Set_Dtext(the_box,quit,'QUIT',System_font,TE_Center);
  175.  
  176.     repeat                                { center the box }
  177.  
  178.        Center_dialog(the_box);
  179.  
  180.                                 { display it }
  181.        pushed := Do_Dialog(the_box,line[1]);
  182.  
  183.                                 { erase it }
  184.        End_dialog(the_box);
  185.  
  186.        if pushed = quit then halt;
  187.  
  188.        if pushed = help then begin
  189.            Obj_SetState(the_box,help,Normal,False);
  190.            show_edit_funcs;
  191.        end;
  192.  
  193.     until pushed = ok;
  194.                                 { get the users entries }
  195.     for i := 1 to numcodes do begin
  196.         Get_Dedit(the_box,line[i],entry[i]);
  197.     end;
  198.  
  199. end; { of procedure dialog }
  200.  
  201. { *************************************************************************** }
  202.  
  203. procedure get_path(var path : str255);
  204.         { finds and returns the default path including drive }
  205.  
  206.    var   i,drive : integer;
  207.  
  208.    procedure d_getpath(var buf:str255; drv:integer); GEMDOS($47);
  209.    function d_getdrv : integer ;  GEMDOS($19);
  210.  
  211. begin
  212.     drive := d_getdrv;
  213.     d_getpath(path,drive+1);
  214.     i:=1;
  215.     while path[i] <> chr(0) do begin
  216.        i := i +1;
  217.     end;
  218.     path[0] := chr(i-1);
  219.     if i > 1 then path := concat(path,'\');
  220.     path := concat('A:\',path);
  221.     path[1] := chr(ord('A') + drive);
  222. end;
  223.  
  224. { *************************************************************************** }
  225.  
  226. procedure patch ( position : integer; new_val : byte ) ;
  227.         { patch new_val into file infile at position - assumes f is open }
  228.         { too bad file value parameters are not allowed }
  229. begin
  230.    get(infile,position);
  231.    infile^ := new_val;
  232.    put(infile,position);
  233. end;
  234.  
  235. { *************************************************************************** }
  236.  
  237.   BEGIN
  238.  {   IF Init_Gem >= 0 THEN   }
  239.       BEGIN
  240.          MAGIC := '$3ABH';
  241.                 { Introduce self }
  242. msg := '[0][   Modify LABELS.PRG?   |      version 1.1| ][ DO IT | ABORT ]';
  243.          ok_button := Do_Alert(msg,1);
  244.          if ok_button = 2 then halt;
  245.  
  246.                 { set path names for infile and outfile }
  247.          get_path(inpath);
  248.          inpath := concat(inpath,pgmname);
  249.  
  250.                 { Is LABELS.PRG there? }
  251.          Reset(infile,inpath);
  252.          if eof(infile) then begin
  253.                 msg :=        '[2][  Couldn''t Open  |';
  254.                 msg := concat(msg,'    LABELS.PRG| | ][ ABORT ]');
  255.                 ok_button := Do_Alert(msg,1);
  256.                 close(infile);
  257.                 halt;
  258.          end;
  259.  
  260.                 { verify magic # }
  261.         for i := 0 to 4 do begin
  262.            get(infile,MAGIC_POS + i);
  263.            if infile^ <> ord(MAGIC[i+1]) then begin
  264.                 msg :=        '[2][  Incompatable version  |';
  265.                 msg := concat(msg,'     of LABELS.PRG| | ][ ABORT ]');
  266.                 ok_button := Do_Alert(msg,1);
  267.                 close(infile);
  268.                 halt;
  269.            end;
  270.         end;
  271.  
  272.                 { get new escape codes }
  273.         get_codes;
  274.  
  275.                 { convert entries to codes - insert commas }
  276.         for i := 1 to numcodes do begin
  277.            for j := 1 to 2 do
  278.                 insert(',',entry[i],j*3);
  279.            code[numcodes-i+1] := entry[i];
  280.         end;
  281.  
  282.                 { put new codes in file }
  283.         start := START_POS;
  284.         for i := 1 to numcodes do
  285.            for j := 1 to codelen do begin
  286.               patch(start,ord(code[i,j]));
  287.               start := start + 1;
  288.            end;
  289.  
  290.         close(infile);
  291.  
  292.         Exit_Gem ;
  293.       END ;
  294.   END.
  295.